home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / helpxref.zip / HELPXREF.PAS < prev   
Pascal/Delphi Source File  |  1990-11-19  |  35KB  |  1,075 lines
  1. Program HelpXRef;
  2.  
  3. { Released to Public Domain by David G. Cohen }
  4.  
  5. { Compiles under Turbo 5.5 with Object Professional 1.02
  6.   untested with 1.03, likely compatible. Problems, questions, remarks,
  7.   or coded additions requested at CIS 70062,1720 or Genie D.COHEN8 }
  8.  
  9. Uses OpLArray,OpFrame,OpString,OpDos,Dos,OpCrt,
  10.      OpSort,OpWindow;
  11.  
  12. const
  13.   MyColors          : ColorSet = (
  14.     TextColor       : $1E;      TextMono        : $0F;
  15.     CtrlColor       : $1E;      CtrlMono        : $0F;
  16.     FrameColor      : $1F;      FrameMono       : $0F;
  17.     HeaderColor     : $1F;      HeaderMono      : $70;
  18.     ShadowColor     : $0B;      ShadowMono      : $0F;
  19.     HighlightColor  : $4F;      HighlightMono   : $70;
  20.     PromptColor     : $1B;      PromptMono      : $07;
  21.     SelPromptColor  : $1F;      SelPromptMono   : $0F;
  22.     ProPromptColor  : $1B;      ProPromptMono   : $07;
  23.     FieldColor      : $1E;      FieldMono       : $0F;
  24.     SelFieldColor   : $3E;      SelFieldMono    : $70;
  25.     ProFieldColor   : $17;      ProFieldMono    : $07;
  26.     ScrollBarColor  : $1B;      ScrollBarMono   : $07;
  27.     SliderColor     : $1B;      SliderMono      : $0F;
  28.     HotSpotColor    : $30;      HotSpotMono     : $70;
  29.     BlockColor      : $3E;      BlockMono       : $0F;
  30.     MarkerColor     : $3F;      MarkerMono      : $70;
  31.     DelimColor      : $1E;      DelimMono       : $0F;
  32.     SelDelimColor   : $31;      SelDelimMono    : $0F;
  33.     ProDelimColor   : $1E;      ProDelimMono    : $0F;
  34.     SelItemColor    : $3E;      SelItemMono     : $70;
  35.     ProItemColor    : $17;      ProItemMono     : $07;
  36.     HighItemColor   : $1F;      HighItemMono    : $0F;
  37.     AltItemColor    : $1F;      AltItemMono     : $0F;
  38.     AltSelItemColor : $3F;      AltSelItemMono  : $70;
  39.     FlexAHelpColor  : $1F;      FlexAHelpMono   : $0F;
  40.     FlexBHelpColor  : $1F;      FlexBHelpMono   : $0F;
  41.     FlexCHelpColor  : $1B;      FlexCHelpMono   : $70;
  42.     UnselXrefColor  : $1E;      UnselXrefMono   : $08;
  43.     SelXrefColor    : $3F;      SelXrefMono     : $70;
  44.     MouseColor      : $4F;      MouseMono       : $70
  45.   );
  46.  
  47.   Version         = '1.06';
  48.   NotFound        = $FFFF;
  49.   FunctorNotFound = #00;
  50.   Delim           = '~';
  51.  
  52.   Status      = 2;
  53.   Result      = 3;       { what line in window to write on }
  54.   CurrentFile = 5;
  55.   Addition    = 10;
  56.  
  57.   Bright      = 100;
  58.  
  59.   LowTopicNumberStart = 100;
  60.  
  61. Type
  62.   CompressedStr = string[7];
  63.  
  64.   IndexPtr = ^IndexRecType;
  65.   IndexRecType = record      { SizeOf = 17 bytes, approx. 5880 recs/100K    }
  66.     Name   : CompressedStr;  { Compression of indexable item name (any str) }
  67.     Volume : Byte;           { Volume number of indexable item (max is 9)   }
  68.     Page   : Word;           { Represent 'nn-nnn' as nnnnn, (max is 65-535) }
  69.     Left,
  70.     Right  : IndexPtr;       { Binary Tree Sibling Pointers                 }
  71.   end;
  72.              { Usage Note: Once found, hi bit of volume is set to 1, so  }
  73.              { in effect, volume:=volume+128.                            }
  74.  
  75.   FileBuffer10KType = Array[1..10240] of Char;
  76.  
  77.   WhereToWrite = Integer;
  78.   DupListType  = Array[1..5000] of char;
  79.  
  80. Var
  81.   AskForKey               : Boolean;            { True if get key when done  }
  82.   BigWindow               : RawWindow;          { Interface window           }
  83.   BytesA                  : word;               { used by compress           }
  84.   BytesB                  : byte;
  85.   BytesC                  : word;
  86.   CurrentSearch           : String;             { What Search proc looks for }
  87.   Debug                   : Boolean;
  88.   DupList                 : DupListType;        { Holds duplicates in index  }
  89.   DupListUsed             : Integer;
  90.   DupTopicNumber          : Word;               { A known method duplicate   }
  91.   ExitRequestPending      : Boolean;            { True of abort requested    }
  92.   FileBuffer10K           : FileBuffer10KType;  { Buffering area             }
  93.   FvDups                  : Text;               { Duplicates file, writing   }
  94.   FvLog                   : Text;               { Log file, writing          }
  95.   IndexFile               : Text;               { Index file, reading        }
  96.   IndexFileName           : String;             { Second paramater, filename }
  97.   InFile                  : Text;               { File currently reading     }
  98.   LargeArr: OpArray;
  99.   Logging                 : Boolean;            { True if /L switch used     }
  100.   LowTopicNumber          : Integer;            { Last reserved # used       }
  101.   MemMark                 : Pointer;            { Start of heap for b-tree   }
  102.   Name                    : CompressedStr;      { A compressed string        }
  103.   NumIncludes             : Integer;
  104.   NumInDupList            : Word;
  105.   NumInIndex              : LongInt;            { Items in the index file    }
  106.   NumTopics               : Word;               { !TOPIC's read so far       }
  107.   NumXRefed               : Word;               { Topics cross refed so far  }
  108.   OutFile                 : Text;               { File currently writing     }
  109.   Page                    : Word;               { Page number out of index   }
  110.   Emulating               : Boolean;            { True if /Q switch used     }
  111.   Root                    : IndexPtr;           { Top of b-tree (index recs) }
  112.   StartMs                 : LongInt;            { Start time                 }
  113.   TempFileName            : String;             { Temporary file name        }
  114.   ThisInclude             : String;             { Name of current !INCLUDE   }
  115.   Timing                  : Boolean;            { True of /T switch used     }
  116.   TopFile                 : Text;               { Top most .txt file         }
  117.   TopFileName             : String;             { First paramater, file name }
  118.   Topic                   : Word;               { Current topic number       }
  119.   TopicAlreadyRead        : Boolean;            { True of topic in var below }
  120.   TopicLinePreviouslyRead : String;             { Associated with above      }
  121.   Volume                  : Byte;               { Volume from index          }
  122.   WriteBuffer10K          : FileBuffer10KType;  { Buffering area             }
  123.   WrittenDups             : Word;
  124.  
  125.  
  126. { Forward references }
  127. Procedure CloseBigWindow; Forward;
  128. Procedure OpenBigWindow; Forward;
  129. Procedure Say(WhatToSay: String; Where: WhereToWrite); Forward;
  130. Procedure VerboseSyntax; Forward;
  131. Function CompressString(S:string) : CompressedStr; Forward;
  132.  
  133. procedure FlushKey;
  134. {- Flush the keyboard buffer }
  135. var
  136.   Tword : word;
  137. begin
  138.   while CheckKbd(Tword) do Tword := ReadKeyWord;
  139. end;
  140.  
  141.  
  142.  
  143. Procedure Error(problem: String);
  144. {- Report problem and halt with error }
  145. Begin
  146.   if not Emulating then Clrscr;    { really just clear bigwindow }
  147.   writeln;
  148.   WriteLn(' There was an error in processing your request.');
  149.   WriteLn;
  150.   Writeln;
  151.   WriteLn(' Cause of Termination: ',problem);
  152.   WriteLn;
  153.   WriteLn;
  154.   WriteLn(' For syntax, please type HELPXREF at the command line.');
  155.   WriteLn;
  156.   if not Emulating then CloseBigWindow;
  157.   Halt(1);
  158. End;
  159.  
  160.  
  161.  
  162. Procedure SetSwitches;
  163. {- Set optional switches, all are false on entry except AskForKey }
  164. Var
  165.   A : Integer;
  166. Begin
  167.   for a:=3 to ParamCount do begin
  168.     if StUpCase(ParamStr(a))      = '/L' then Logging:=True
  169.     else if StUpCase(ParamStr(a)) = '/T' then Timing:=True
  170.     else if StUpCase(ParamStr(a)) = '/E' then Emulating:=True
  171.     else if StUpCase(ParamStr(a)) = '/N' then AskForKey:=False
  172.     else if StUpCase(ParamStr(a)) = '/D' then Debug:=True
  173.     else if ParamStr(a)           = '/?' then VerboseSyntax
  174.     else begin
  175.       Emulating:=True;    { because window is not open yet }
  176.       Error('Invalid parameter "'+ParamStr(a)+'"');
  177.     end;
  178.   end;
  179. End;
  180.  
  181. Procedure InitializeGlobals;
  182. {- Initialize all global variables }
  183. Begin
  184.   Logging:=False;  Timing:=False;  Emulating:=False;   Debug:=False;
  185.   AskForKey:=True;
  186.   LowTopicNumber:=LowTopicNumberStart;
  187.   ExitRequestPending:=False;
  188.   Root:=Nil;  NumXRefed:=0;  NumTopics:=0;  NumInIndex:=0;
  189.   WrittenDups:=0;  DupListUsed:=0;  NumInDupList:=0;
  190.   NumIncludes:=0;
  191.   TempFileName:='ADDREFS$.$$$';
  192.   TopFileName:=ParamStr(1);
  193. End;
  194.  
  195. Procedure AssignFiles;
  196. {- Make global file assignments }
  197. Begin
  198.   if paramcount < 2 then Error('Files not specified.');
  199.   if not ExistFile(ParamStr(1)) then
  200.     Error('Top-most file "'+TopFileName+'" not found.');
  201.   Assign(Topfile,TopFileName);
  202.   Reset(TopFile);
  203.   Assign(OutFile,TempFileName);
  204.   Rewrite(OutFile);
  205.   IndexFileName:=ParamStr(2);
  206.  
  207.   if Logging then begin
  208.     assign(FvLog,'HELPXREF.LOG');
  209.     rewrite(FvLog);
  210.     writeln(FvLog,'The following are topics which are not in the index.');
  211.     writeln(FvLog);
  212.   end;
  213.  
  214.   assign(FvDups,'HELPXREF.DUP');
  215.   rewrite(FvDups);
  216. End;
  217.  
  218. Procedure VerboseSyntax;
  219. {- Give long syntax screen, if paramcount = 0 or /? specified, halt with error }
  220. Begin
  221.   WriteLn;
  222.   WriteLn('HELPXREF by David G. Cohen  CIS 70062,1720  -or- Genie D.COHEN8');
  223.   WriteLn;
  224.   WriteLn('HelpXRef performs three major functions which will hopefully');
  225.   WriteLn('increase the functionality of your OPRO hypertext help.');
  226.   WriteLn('1. Add page references to all methods.');
  227.   WriteLn('2. Build new topics for duplicate methods which are linked to');
  228.   WriteLn('   the objects where the methods are defined.');
  229.   WriteLn('3. Link each method which exists in more than one object with');
  230.   WriteLn('   all the other objects where the method exists.');
  231.   WriteLn;
  232.   WriteLn('Syntax:  HELPXREF topfile indexfile [optional switches]');
  233.   WriteLn('         Topfile is the topmost help file which INCLUDEs others.');
  234.   WriteLn('         Indexfile is the index distributed with opro.');
  235.   WriteLn;
  236.   WriteLn('         Optional Switches: ');
  237.   WriteLn('         /D  Duplicates Place duplicates in HELPXREF.DUP');
  238.   WriteLn('         /E  Emulate    Screen output will appear in opro''s format.');
  239.   WriteLn('         /L  Log        Log a summary to HELPXREF.LOG.');
  240.   WriteLn('         /N  No Ask     Do not ask to press a key upon completion.');
  241.   WriteLn('         /T  Time       Time the execution.');
  242.   Halt(1);
  243. End;
  244.  
  245.  
  246. Procedure Initialize;
  247. {- Set up windows, globals, files, etc }
  248. Begin
  249.   if ParamCount = 0 then VerboseSyntax;
  250.   InitializeGlobals;
  251.   SetSwitches;
  252.   FlushKey;
  253.   if not Emulating then
  254.     OpenBigWindow
  255.   else
  256.     WriteLn;
  257.   Say('Initializing.',Status);
  258.   AssignFiles;
  259.   if Timing then StartMs:=TimeMs;
  260. End;
  261.  
  262. Procedure WriteHeaderGroup1;
  263. {- Write headers for use in adding page references }
  264. Begin
  265.   BigWindow.wFastWrite('Current File   :',CurrentFile,2,MyColors.PromptColor);
  266.   BigWindow.wFastWrite('Indexed Item',CurrentFile+1,2,MyColors.PromptColor);
  267.   BigWindow.wFastWrite('Added Reference',CurrentFile+1,51,MyColors.PromptColor);
  268. End;
  269.  
  270. Procedure WriteHeaderGroup2;
  271. {- Write headers for use in adding duplicate topics }
  272. Begin
  273.   BigWindow.wFastWrite('Current File   :',CurrentFile,2,MyColors.PromptColor);
  274.   BigWindow.wFastWrite('Duplicated Method',CurrentFile+1,2,MyColors.PromptColor);
  275.   BigWindow.wFastWrite('Associated Object',CurrentFile+1,51,MyColors.PromptColor);
  276. End;
  277.  
  278.  
  279. Procedure CreateANode(var Root: IndexPtr);
  280. {- Add a node to the tree which has current index information }
  281. Begin
  282.   if MaxAvail >= SizeOf(IndexRecType) then
  283.   begin
  284.     New(Root);
  285.     Root^.Name   := Name;
  286.     Root^.Page   := Page;
  287.     Root^.Volume := Volume;
  288.     Root^.Left   := Nil;
  289.     Root^.Right  := Nil;
  290.   end
  291.   else
  292.     Error('Out of memory.');
  293. End;
  294.  
  295.  
  296. Procedure UpdateTree(var Root: IndexPtr);
  297. {- Place information into tree if it's not already there }
  298. Begin
  299.   if Root=nil then CreateANode(Root)
  300.   else
  301.   begin
  302.     if Name < Root^.Name then UpdateTree(Root^.Left)
  303.     else
  304.     begin
  305.       if Name > Root^.Name then UpdateTree(Root^.Right)
  306.       else {match found}
  307.       begin
  308.       end;
  309.     end;
  310.   end;
  311. End;
  312.  
  313.  
  314. Procedure Say(WhatToSay : String; Where : WhereToWrite);
  315. {- Write information into the on-screen window, or to screen if Emulating }
  316. Var FlashIt: Boolean;
  317. Begin
  318.   FlashIt:=False;
  319.   if Where > Bright then begin
  320.     FlashIt:=True;
  321.     Where:=Where-Bright;
  322.   end;
  323.   if not Emulating then
  324.   begin
  325.     if Where = Addition then begin
  326.       ScrollWindowUp(4,12,75,15,1);
  327.       BigWindow.wFastWrite(WhatToSay,Addition,2,MyColors.TextColor);
  328.     end
  329.     else begin
  330.       if not FlashIt then
  331.         BigWindow.wFastWrite(pad(WhatToSay,45),Where,19,MyColors.TextColor)
  332.       else
  333.         BigWindow.wFastWrite(pad(WhatToSay,45),Where,19,MyColors.AltItemColor);
  334.     end
  335.   end
  336.   else
  337.     if (Where = Status) or (Where=CurrentFile) then
  338.       WriteLn(pad(WhatToSay,45));
  339. End;
  340.  
  341. Procedure AddToDupList(Functor : string);
  342. {- Add a method to the duplicate list, if it's not there }
  343. Var
  344.   TempFunctor: String;
  345.   CompressedFunctor: CompressedStr;
  346. Begin
  347.   TempFunctor:=pad(functor,8);
  348.   TempFunctor:=StUpCase(ExtractWord(1,TempFunctor,['.',' ']));
  349.   CompressedFunctor:=CompressString(TempFunctor);
  350.   CompressedFunctor:=pad(CompressedFunctor,8);
  351.   if search(DupList,DupListUsed,CompressedFunctor,
  352.          length(CompressedFunctor)) = NotFound then
  353.   begin
  354.     inc(NumInDupList);
  355.     Move(CompressedFunctor,DupList[DupListUsed],sizeof(CompressedStr));
  356.     DupListUsed:=DupListUsed+sizeof(CompressedStr);
  357.   end;
  358. end;
  359.  
  360.  
  361. Procedure ReadIndex;
  362. {- Read the index file and store information into the tree }
  363. var
  364.   Functor      : String;
  365.   IndexEntry   : String;
  366.   LastFunctor  : String;
  367.   Line         : String;
  368.   ObjectName   : String;
  369.   Temp         : String[1];
  370.   UnitName     : String;
  371. begin
  372.   Say('Scanning index file.',Status);
  373.   if not ExistFile(IndexFileName) then
  374.     Error('Index file "'+IndexFileName+'" not found.');
  375.   assign(indexfile,indexfilename);
  376.   settextbuf(indexfile,FileBuffer10K);
  377.   reset(indexfile);
  378.   Repeat
  379.     ReadLn(Indexfile,Line);
  380.     Line := trim(Line);
  381.     if Line[1] = '{' then
  382.     begin
  383.       UnitName    := ExtractWord(4,Line,[' ']) ;         { unit name     }
  384.       LastFunctor := StUpCase(Functor);
  385.       Functor     := '.' + ExtractWord(3,Line,[' ']) ;   { function name }
  386.       ObjectName  := '.' + ExtractWord(5,Line,[' ']);    { object name   }
  387.  
  388.       if LastFunctor = StUpCase(Functor) then
  389.         AddToDupList(Functor);
  390.  
  391.       if pos('----',ObjectName) <> 0 then ObjectName:='';    { no object }
  392.  
  393.       { initialize the compression string's length }
  394.       Name:='1234567';
  395.       Name:=CompressString(StUpCase(UnitName+Functor+ObjectName));
  396.  
  397.       if not Str2Word(ExtractWord(2,Line,[' ','-']) +
  398.                       ExtractWord(3,Line,[' ','-']), Page) then
  399.                       Page:=0;  { means to use '*NEW*' }
  400.  
  401.       Temp:=ExtractWord(1,Line,[' ','{','}']);
  402.       if Length(Temp) > 1 then Error('Found volume > 9 in index.');
  403.       Volume:=ord(Temp[1])-48;
  404.  
  405.       inc(NumInIndex);
  406.       UpdateTree(Root);
  407.     end;
  408.   Until eof(indexfile);
  409.   Say('There are '+Long2Str(NumInIndex)+' topics in the index.',Result);
  410. end;
  411.  
  412. Procedure XRefMethod(Method: String; ThisObject: String);
  413. {- If this is a duplicated method, write it to the .DUP file }
  414. Var
  415.   CompressedMethod       : CompressedStr;
  416.   TempMethod             : String;
  417. Begin
  418.   TempMethod:=pad(method,8);
  419.   TempMethod:=StUpCase(ExtractWord(1,TempMethod,['.',' ']));
  420.   CompressedMethod:=CompressString(TempMethod);
  421.   compressedmethod:=pad(compressedmethod,8);
  422.   if search(DupList,DupListUsed,CompressedMethod[1],sizeof(CompressedStr)-1)
  423.      <> NotFound then
  424.   begin
  425.     WriteLn(FvDups,StUpCase(Method),Delim,StUpCase(ThisObject),Delim,Topic);
  426.     inc(WrittenDups);
  427.   end;
  428. End;
  429.  
  430. {- Sort get, put, compare }
  431. {$F+}
  432. Procedure GetStr;
  433. Var x: Word;
  434.     Line: String[60];
  435. Begin
  436.   for x:=1 to WrittenDups do
  437.   begin
  438.     LargeArr.RetA(x,1,Line);
  439.     if not PutElement(Line) then
  440.       writeln('no put');
  441.   end;
  442. End;
  443.  
  444. Function LessFunc(var x,y) : Boolean;
  445. Var
  446.   X1 : String[60] absolute x;
  447.   Y1 : String[60] absolute y;
  448. Begin
  449.   LessFunc:= X1 < Y1;
  450. End;
  451.  
  452. Procedure PutElem;
  453. Var x: Word;
  454.     Line:String[60];
  455. Begin
  456.   for x:=1 to WrittenDups do
  457.   begin
  458.     if not GetElement(Line) then
  459.       writeln('no get');
  460.     LargeArr.SetA(x,1,Line);
  461.   end;
  462. End;
  463. {$F-}
  464.  
  465.  
  466. Procedure WriteNewHelp;
  467. {- Writes NEWXREFS.TXT which gets included in topfile }
  468. Var
  469.   A: Integer;
  470.   DupEntry : String[60];
  471.   WhichEntry: Word;
  472.   FvDups : Text;
  473.   CurrentMethod,
  474.   Method,
  475.   ObjectReference,
  476.   MethodTopic : String;
  477.   IssueCr     : Boolean;
  478. Begin
  479.   Say('Writing duplicate method references.',Status);
  480.   if not Emulating then WriteHeaderGroup2;
  481.   Say('"NEWXREFS.TXT"',CurrentFile);
  482.   assign(FvDups,'NEWXREFS.TXT');
  483.   if ioresult<>0 then begin
  484.     writeln('file error 1');
  485.     halt(1);
  486.   end;
  487.   settextbuf(FvDups,FileBuffer10K);
  488.   rewrite(FvDups);
  489.   WriteLn(FvDups,'; This file was created by HELPXREF.');
  490.   WriteLn(FvDups,'; It is included from your topmost file and prohibits the system');
  491.   WriteLn(FvDups,'; from assuming the object which goes with the method passed to it.');
  492.   WriteLn(FvDups,'; For instance, ''Init'' will no longer just pick the first object');
  493.   WriteLn(FvDups,'; where an init method is defined; instead, you will be presented');
  494.   WriteLn(FvDups,'; with a choice of objects all linked as required.');
  495.   WriteLn(FvDups,'; Please see the comments about biasing at the end of this file.');
  496.   WriteLn(FvDups,'; These comments may be removed if desired.');
  497.   WriteLn(FvDups);
  498.   if ioresult<>0 then begin
  499.     writeln('file error 2');
  500.     halt(1);
  501.   end;
  502.   WhichEntry:=1;
  503.  Repeat
  504.   LargeArr.RetA(WhichEntry,1,DupEntry);
  505.   CurrentMethod:=ExtractWord(1,DupEntry,[Delim]);
  506.   ObjectReference:=ExtractWord(2,DupEntry,[Delim]);
  507.   MethodTopic:=LeftPad(ExtractWord(3,DupEntry,[Delim]),5);
  508.   for a:=1 to 4 do
  509.     if MethodTopic[a]=' ' then MethodTopic[a]:='0';
  510.   WriteLn(FvDups,'!TOPIC ',LowTopicNumber,' ',CurrentMethod);
  511.   inc(LowTopicNumber);
  512.   WriteLn(FvDups,'!NOINDEX');
  513.   WriteLn(FvDups,'!BIAS ',LowTopicNumberStart+NumInDupList);
  514.   WriteLn(FvDups);
  515.   WriteLn(FvDups,'The ',CurrentMethod,' method is defined in these objects;');
  516.   WriteLn(FvDups);
  517.   Method:=CurrentMethod;
  518.   IssueCR:=True;
  519.   Repeat
  520.     Write(FvDups,pad('   '+#4+MethodTopic+#5+ObjectReference+#5,35));
  521.     IssueCR:=not IssueCR;
  522.     if IssueCr then Writeln(FvDups);
  523.     inc(WhichEntry);
  524.     if WhichEntry <= WrittenDups then
  525.     begin
  526.       Say(copy(pad(StLoCase(CurrentMethod),47)+'  '+StLoCase(ObjectReference),1,72),Addition);
  527.       LargeArr.RetA(WhichEntry,1,DupEntry);
  528.       Method:=ExtractWord(1,DupEntry,[Delim]);
  529.       ObjectReference:=ExtractWord(2,DupEntry,[Delim]);
  530.       MethodTopic:=LeftPad(ExtractWord(3,DupEntry,[Delim]),5);
  531.       for a:=1 to 4 do
  532.         if MethodTopic[a]=' ' then MethodTopic[a]:='0';
  533.     end;
  534.   Until (Method<>CurrentMethod) or (WhichEntry > WrittenDups);
  535.   Writeln(FvDups);
  536.   Writeln(FvDups,'!BIAS 0');
  537.   Writeln(FvDups);
  538.   Writeln(FvDups,';----------------------------------------------------------');
  539.   WriteLn(FvDups);
  540.  Until (WhichEntry > WrittenDups);
  541.  WriteLn(FvDups,'!BIAS ',LowTopicNumberStart+NumInDupList);
  542.  WriteLn(FvDups,'; This bias is minimal and will not waste space in the resulting');
  543.  WriteLn(FvDups,'; compiled help file. It is placed here by HELPXREF to ensure that');
  544.  WriteLn(FvDups,'; the topics are not overwritten by any of the opro topics or');
  545.  WriteLn(FvDups,'; topics you may have added.');
  546.  close(FvDups);
  547. End;
  548.  
  549.  
  550. Procedure LogDups;
  551. {- If debug is on, dump all duplicates (sorted) into HelpXRef.Dup }
  552. Var
  553.   FvDups: Text;
  554.   Loop  : Integer;
  555.   DuplicatedMethod : String;
  556. Begin
  557.   assign(FvDups,'HELPXREF.DUP');
  558.   rewrite(FvDups);
  559.   WriteLn(FvDups,'The following are methods which exist in multiple objects.');
  560.   WriteLn(FvDups);
  561.   WriteLn(FvDups,'Object              Method                        Topic Number');
  562.   for Loop:=1 to WrittenDups do
  563.   begin
  564.     LargeArr.RetA(Loop,1,DuplicatedMethod);
  565.     Write(FvDups,pad(ExtractWord(1,DuplicatedMethod,[Delim]),20));
  566.     Write(FvDups,pad(ExtractWord(2,DuplicatedMethod,[Delim]),30));
  567.     WriteLn(FvDups,pad(ExtractWord(3,DuplicatedMethod,[Delim]),10));
  568.   end;
  569.   close(FvDups);
  570. End;
  571.  
  572.  
  573. Procedure BuildMasterDupXRefs;
  574. {- Build the master index of duplicate methods }
  575. Var
  576.   Line: String[60];
  577.   a:integer;
  578.   count: word;
  579. Begin
  580.   Say('Sorting duplicate method references.',Status);
  581.   Say(Long2Str(WrittenDups)+' of out '+Long2Str(NumXRefed)+' are duplicate methods.',Result);
  582.   if not Emulating then ScrollWindowUp(4,10,75,15,6);
  583.   count:=0;
  584.   assign(FvDups,'HELPXREF.DUP');
  585.   settextbuf(FvDups,FileBuffer10K);
  586.   reset(FvDups);              {60}
  587.   LargeArr.Init(WrittenDups, 1, 60, 'HELPXREF.ARR', MaxAvail, lDeleteFile,
  588.                 DefaultPriority);
  589.   While not eof(FvDups) do
  590.   begin
  591.     ReadLn(FvDups,Line);
  592.     inc(count);
  593.     LargeArr.SetA(count,1,Line);
  594.   end;
  595.   close(FvDups);
  596.   if count > 0 then
  597.     if Sort(count,60,GetStr,LessFunc,PutElem)  = SortOutOfMemory then
  598.       Error('Out of memory (No room to sort).');
  599.  
  600.   if not Debug then
  601.   begin
  602.     assign(FvDups,'HELPXREF.DUP');
  603.     erase(FvDups);
  604.   end
  605.   else
  606.     LogDups;
  607.  
  608.   WriteNewHelp;
  609. End;
  610.  
  611.  
  612. Function NextTopic: String;
  613. {- Find the next topic sequentially (From current !INCLUDE) }
  614. Var
  615.   Line    : String;
  616.   Functor : String;
  617. Begin
  618.   if TopicAlreadyRead then
  619.     Line:=TopicLinePreviouslyRead
  620.   else
  621.   begin
  622.     Line:='';
  623.     while (pos('!TOPIC',Line) <> 1) and (not eof (infile))  do begin
  624.       ReadLn(InFile,Line);
  625.       WriteLn(OutFile,Line);
  626.     End;
  627.   End;
  628.  
  629.  
  630.   if eof(infile) then
  631.     Functor:=FunctorNotFound
  632.   else begin                                { Line contains the !TOPIC }
  633.     Functor := ExtractWord(3,Line,[' ']);
  634.     if not Str2Word(ExtractWord(2,Line,[' ']),topic) then
  635.       NumTopics:=NumTopics-1;
  636.     inc(NumTopics);
  637.   end;
  638.  
  639.   NextTopic:=Functor;
  640. End;
  641.  
  642.  
  643. Function SearchTreeFor(Var Root:IndexPtr; Target:CompressedStr): IndexPtr;
  644. {- Find target in the tree starting at the root }
  645. begin
  646.   if Root=Nil then SearchTreeFor:=nil
  647.   else
  648.   begin
  649.     if Target < Root^.Name then SearchTreeFor:=SearchTreeFor(Root^.Left,Target)
  650.     else
  651.     begin
  652.       if Target > Root^.Name then SearchTreeFor:=SearchTreeFor(Root^.Right,Target)
  653.       else {match found}
  654.       begin
  655.         SearchTreeFor:=Root;
  656.       end;
  657.     end;
  658.   end;
  659. End;
  660.  
  661.  
  662. Procedure PayAttentionToUser;
  663. {- User has pressed a key, user may wish to abort }
  664. Var ch: char;
  665. Begin
  666.   ch:=ReadKey;
  667.   if ch=#0 then ch:=ReadKey;
  668.   Say('Process suspended.',Status);
  669.   Say('Press [A] to Abort, any other key to resume.',Result);
  670.   ch:=ReadKey;
  671.   Say('Inserting page references.',Status);
  672.   if UpCase(ch)='A' then begin
  673.     ExitRequestPending:=True;
  674.     Say('Request to abort pending!',Bright+Result);
  675.   end
  676.   else
  677.     Say('There are '+Long2Str(NumInIndex)+' topics in the index.',Result);
  678. End;
  679.  
  680.  
  681.  
  682.  
  683. Procedure FindIndexReference;
  684. {- See if there's an entry in the index for current topic }
  685. Var
  686.   Line              : String;
  687.   Done              : Boolean;
  688.   ThisProc,
  689.   CompressedCurrent : CompressedStr;
  690.   PageRef           : String;
  691.   LastLine          : String;
  692.   ObjectName        : String;
  693.   Node              : IndexPtr;
  694.   WhatToSay,
  695.   PageStr           : String;
  696.   DuplicateRef      : String;
  697.  
  698. Begin
  699.   ObjectName:='';
  700.   CompressedCurrent:='1234567';
  701.   CompressedCurrent:=CompressString(CurrentSearch);
  702.   Node:=SearchTreeFor(Root,CompressedCurrent);
  703.   TopicAlreadyRead:=False;
  704.   while (Line[1]<>#2) and (not eof (infile)) and (not TopicAlreadyRead) do
  705.     begin
  706.       ReadLn(InFile,Line);
  707.       if (pos('!TOPIC',Line)) = 1 then begin
  708.         TopicAlreadyRead:=True;
  709.         WriteLn(OutFile,Line);
  710.         TopicLinePreviouslyRead:=Line;
  711.         Exit;
  712.       end;
  713.       WriteLn(OutFile,Line);
  714.     end;
  715.   ObjectName:=ExtractWord(2,Line,[#5]);   { get object }
  716.  
  717.   if Node = Nil then begin
  718.     CurrentSearch:=StUpCase(CurrentSearch+'.'+ObjectName);
  719.     CompressedCurrent:=CompressString(CurrentSearch);
  720.     Node:=SearchTreeFor(Root,CompressedCurrent);
  721.     if Logging then
  722.       if Node = Nil then
  723.         WriteLn(FvLog,CurrentSearch);
  724.   end;
  725.  
  726.   if Node <> Nil then begin
  727.     if Node^.Volume > 9 then
  728.       Node^.Volume:=Node^.Volume-128;   { Temporarily mark as unused }
  729.     ThisProc:=Node^.Name;
  730.     PageStr:=Long2Str(Node^.Page);
  731.     insert('-',PageStr,Length(PageStr)-2);
  732.     WhatToSay:=StLoCase(ExtractWord(2,CurrentSearch,['.']));
  733.     { WhatToSay is the method name, do some cross referencing }
  734.     XRefMethod(WhatToSay,ObjectName);
  735.     If ObjectName <> '' then
  736.       WhatToSay:=ObjectName+'.'+WhatToSay;
  737.     if PageStr='-0' then begin
  738.       PageRef:='Text Reference: '+#2+
  739.                'This item is newer than the manuals. Check update listing'+#2;
  740.       Say(pad(WhatToSay,47)+'  '+'Check update listing',Addition);
  741.     end
  742.     else begin
  743.       PageRef:='Text Reference: '+#2+'Volume ' + Long2Str(Node^.Volume) +
  744.                ', page ' + PageStr+#2;
  745.  
  746.       Say(pad(WhatToSay,47) + '  ' +
  747.                  copy(PageRef,18,Length(PageRef)-18),Addition);
  748.  
  749.     end;
  750.     Node^.Volume:=Node^.Volume + 128;   { mark as used, see type defn. }
  751.     inc(NumXRefed);
  752.  
  753.  
  754.     Done:=FALSE;
  755.     if not eof(Infile) then
  756.     Repeat
  757.       ReadLn(Infile,Line);
  758.       if (pos('Text Reference: '+#2,Line)) <> 1 then begin
  759.         if (pos(';',Line)=1) then begin
  760.           if Length(LastLine) > 0 then
  761.             WriteLn(OutFile);           { ensure 1 blank line only }
  762.           WriteLn(OutFile,PageRef);
  763.           Done:=TRUE;
  764.         end;
  765.         WriteLn(OutFile,Line);
  766.         LastLine:=Line;
  767.       end;
  768.     Until Done or (eof(InFile));
  769.  
  770.     if not done then begin       { reached eof before writing reference }
  771.       WriteLn(OutFile);
  772.       WriteLn(OutFile,PageRef);
  773.     end;
  774.   end
  775. End;
  776.  
  777. Procedure OpenBigWindow;
  778. {- Initialize output window }
  779. Begin
  780.   BigWindow.InitCustom(4,6,76,16,MyColors,wbordered);
  781.   BigWindow.enableexplosions(8);
  782.   BigWindow.wFrame.AddShadow(shBR,shSeeThru);
  783.   BigWindow.wFrame.AddHeader(' HelpXRef ',HeTC);
  784.   BigWindow.wFrame.AddHeader(' Version '+Version+' ══',HeBR);
  785.   BigWindow.draw;
  786.   BigWindow.wFastWrite('Current Action :',Status,2,MyColors.PromptColor);
  787.   BigWindow.wFastWrite('Status Remark  :',Result,2,MyColors.PromptColor);
  788. End;
  789.  
  790. Procedure SaySuccess;
  791. { Give success message if applicable }
  792. Var Seconds,Minutes: Longint;
  793. Begin
  794.   WriteLn;
  795.   if ExitRequestPending then begin
  796.     WriteLn(' The process was aborted.');
  797.     WriteLn;
  798.     WriteLn(' Topics in Index File    : ',NumInIndex);
  799.     WriteLn(' Topics Cross Referenced : ',NumXRefed,' (prior to abort)');
  800.     WriteLn;
  801.     if Logging then
  802.       WriteLn(' Request to log results was not processed.');
  803.     if Timing then
  804.       WriteLn(' Request to time execution was not processed.');
  805.   end
  806.   else { user did not abort }
  807.   begin
  808.     if NumXRefed = 0 then begin
  809.       WriteLn(' No topics were cross referenced.');
  810.       WriteLn;
  811.       WriteLn(' Check: ');
  812.       WriteLn('   1) Specification of files');
  813.       WriteLn('   2) Structure of the index file');
  814.       WriteLn('   3) Documentation');
  815.     end
  816.     else begin
  817.       Write(' Cross referencing completed successfully');
  818.       if Timing then begin
  819.         Seconds:=(TimeMs-StartMs) div 1000;
  820.         Minutes:=Seconds div 60;
  821.         Seconds:=Seconds - Minutes * 60;
  822.         Write(' in ',Minutes,' min, ',Seconds,' sec');
  823.       end;
  824.       if Logging then Write(', log created');
  825.       WriteLn('.');
  826.       WriteLn;
  827.       WriteLn(' Topics in Index File    : ',NumInIndex);
  828.       WriteLn(' Total !TOPICs Found     : ',NumTopics);
  829.       WriteLn(' Topics Cross Referenced : ',NumXRefed);
  830.       WriteLn(' Duplicate Methods Found : ',LowTopicNumber-LowTopicNumberStart);
  831.     end;
  832.   end;
  833.   WriteLn;
  834. End;
  835.  
  836. Procedure CloseBigWindow;
  837. { Close the output window }
  838. Var
  839.   a:char;
  840. Begin
  841.   if AskForKey then begin
  842.     Write(' Please press a key. ');
  843.     a:=ReadKey;
  844.   end;
  845.   BigWindow.Erase;
  846.   BigWindow.Done;
  847. End;
  848.  
  849.  
  850. Procedure DoThisInclude;
  851. { Process the next include (ThisInclude) }
  852. Var
  853.   Functor: String;
  854. Begin
  855.   assign(InFile,ThisInclude);
  856.   SetTextBuf(InFile,FileBuffer10K);
  857.   reset(InFile);
  858.  
  859.   Say(ThisInclude,CurrentFile);
  860.   if not Emulating then ScrollWindowUp(4,12,75,15,4);
  861.   while not eof(InFile) do begin
  862.     Functor:=NextTopic;
  863.     if KeyPressed then PayAttentionToUser;
  864.     CurrentSearch:=StUpCase(JustName(ThisInclude)+'.'+Functor);
  865.     if Functor <> FunctorNotFound then FindIndexReference;
  866.   end;
  867.   close(infile);
  868.   erase(infile);
  869.   close(outfile);
  870.   rename(outfile,ThisInclude);
  871.   assign(outfile,TempFileName);
  872.   settextbuf(outfile,WriteBuffer10K);
  873.   rewrite(outfile);
  874. End;
  875.  
  876. Procedure AlterTopFile;
  877. {- Alter Topmost file to include NEWXREFS.TXT }
  878. Var
  879.   AddedFlag:Boolean;
  880.   Line: String;
  881. Begin
  882.   Assign(InFile,TopFileName);
  883.   reset(InFile);
  884.   Assign(OutFile,'HELPXREF.$$$');
  885.   rewrite(OutFile);
  886.   AddedFlag:=False;
  887.   while not eof(InFile) do
  888.   begin
  889.     ReadLn(InFile,Line);
  890.     if (not AddedFlag) and (StUpCase(ExtractWord(1,Line,[' '])) = '!INCLUDE') then
  891.     begin
  892.       if ExtractWord(2,Line,[' ']) <> 'NEWXREFS.TXT' then
  893.       begin
  894.         WriteLn(OutFile,'!INCLUDE NEWXREFS.TXT');
  895.         WriteLn(OutFile,'; The preceeding line was generated by HelpXRef. ');
  896.         WriteLn(OutFile,'; This include must come BEFORE all other includes.');
  897.         WriteLn(OutFile,';');
  898.       end;
  899.       AddedFlag:=TRUE;
  900.     end;
  901.     WriteLn(OutFile,Line);
  902.   end;
  903.   close(InFile);
  904.   erase(InFile);
  905.   close(OutFile);
  906.   assign(OutFile,'HELPXREF.$$$');
  907.   rename(OutFile,TopFileName);
  908. End;
  909.  
  910.  
  911. Procedure Process;
  912. {- Process the topmost file }
  913. Var
  914.   Line:String;
  915. Begin
  916.   Mark(memmark);
  917.   ReadIndex;
  918.   if not Emulating then WriteHeaderGroup1;
  919.   Say('Inserting page references.',Status);
  920.   Repeat
  921.     ReadLn(TopFile,Line);
  922.     if pos('!INCLUDE',StUpCase(Line)) = 1 then begin
  923.       ThisInclude:=ExtractWord(2,Line,[' ']);
  924.       if StUpCase(ThisInclude) <> 'NEWXREFS.TXT' then
  925.       begin
  926.         inc(NumIncludes);
  927.         if not ExistFile(ThisInclude) then
  928.           Error('Can''t include '+ThisInclude+', not found.');
  929.         DoThisInclude;
  930.         if ExitRequestPending then Exit;
  931.       end;
  932.     End;
  933.   Until eof(TopFile);
  934.   close(FvDups);
  935.   release(memmark);
  936.   if WrittenDups > 0 then
  937.   begin
  938.     BuildMasterDupXRefs;
  939.     AlterTopFile;
  940.   end;
  941. End;
  942.  
  943.  
  944. Procedure LogIndexNotUsed(Root: IndexPtr);
  945. {- if logging, write parts of index not used }
  946. Var
  947.   Line: String;
  948.   UnitName,
  949.   Functor,
  950.   ObjectName: String;
  951.   Name: CompressedStr;
  952.   Node: IndexPtr;
  953. Begin
  954.   Say('Logging to HELPXREF.LOG.',Status);
  955.   Say('Cross referenced '+Long2Str(NumXRefed)+' topics.',Result);
  956.   if not Emulating then ScrollWindowUp(4,10,76,15,6);
  957.   WriteLn(FvLog);
  958.   WriteLn(FvLog,'The following are items in the index for which a topic was not found.');
  959.   Writeln(FvLog);
  960.   assign(indexfile,indexfilename);
  961.   settextbuf(indexfile,FileBuffer10K);
  962.   reset(indexfile);
  963.   Repeat
  964.     ReadLn(Indexfile,Line);
  965.     Line := trim(Line);
  966.     if Line[1] = '{' then
  967.     begin
  968.       UnitName    := ExtractWord(4,Line,[' ']) ;         { unit name     }
  969.       Functor     := '.' + ExtractWord(3,Line,[' ']) ;   { function name }
  970.       ObjectName  := '.' + ExtractWord(5,Line,[' ']);    { object name   }
  971.       if pos('----',ObjectName) <> 0 then ObjectName:='';
  972.       Name:='1234567';   { initialize compression string }
  973.       Name:=CompressString(StUpCase(UnitName+Functor+ObjectName));
  974.       Node:=SearchTreeFor(Root,Name);
  975.       if Node^.Volume < 10 then
  976.         if UnitName <> '' then begin
  977.           if Length(ObjectName) = 0 then
  978.             Write(FvLog,pad(copy(Functor,2,length(Functor)),40))
  979.           else
  980.             Write(FvLog,pad(copy(ObjectName,2,length(ObjectName))+
  981.                         Functor,40));
  982.           WriteLn(FvLog,' ('+UnitName+')');
  983.         end;
  984.     end;
  985.   Until eof(indexfile);
  986.   close(IndexFile);
  987. End;
  988.  
  989. Procedure LogVars;
  990. {- Write stats }
  991. Begin
  992.   Writeln(FvLog);
  993.   Writeln(FvLog,'Summary:');
  994.   Writeln(FvLog);
  995.   Writeln(FvLog,'!INCLUDE directives           : ',NumIncludes);
  996.   Writeln(FvLog,'!TOPIC directives             : ',NumTopics);
  997.   Writeln(FvLog,'Items found in index file     : ',NumInIndex);
  998.   Writeln(FvLog,'Index entrys with no !TOPIC   : ',NumInIndex-NumXRefed);
  999.   Writeln(FvLog,'Page references added         : ',NumXRefed);
  1000.   Writeln(FvLog,'Duplicate method topics added : ',LowTopicNumber-LowTopicNumberStart);
  1001.   Writeln(FvLog,'References to above added     : ',WrittenDups);
  1002.   Writeln(FvLog,'Total new cross references    : ',LowTopicNumber-LowTopicNumberStart+
  1003.                                                    NumXRefed+WrittenDups);
  1004.   WriteLn(FvLog);
  1005. End;
  1006.  
  1007. Procedure WrapUp;
  1008. {- Tidy up }
  1009. Var a:char;
  1010.     FvDel: Text;
  1011. Begin
  1012.   if Logging then begin
  1013.     if not ExitRequestPending then
  1014.     begin
  1015.       LogIndexNotUsed(Root);
  1016.       LogVars;
  1017.     end;
  1018.     close(FvLog);
  1019.   end;
  1020.   if not Emulating then ClrScr;
  1021.   SaySuccess;
  1022.   if not Emulating then CloseBigWindow;
  1023.   if ExistFile('ADDREFS$.$$$') then
  1024.   begin
  1025.     assign(FvDel,'ADDREFS$.$$$');
  1026.     erase(FvDel);
  1027.   end;
  1028. End;
  1029.  
  1030.  
  1031. { Thanks to Major Robert W. Reed for CompressString, public domain }
  1032.  
  1033. {- Return a statistically unique eight byte code }
  1034. function CompressString(S:string) : CompressedStr;
  1035. var
  1036.   i : byte;
  1037.   T : CompressedStr;
  1038. begin
  1039.   { compress if original string is longer than compressed string }
  1040.   if length(S) > 7 then
  1041.   begin
  1042.     { initialize vars }
  1043.     BytesA    := ord(S[2]);
  1044.     BytesC    := ord(S[3]);
  1045.     BytesB    := ord(S[length(S)]);
  1046.  
  1047.     { perform the numeric compressions }
  1048.     for i := 1 to length(S) do
  1049.     begin
  1050.       BytesA :=  BytesA XOR (ord(S[i]) * i);
  1051.       BytesB :=  BytesB XOR (ord(S[i]) * i);
  1052.       BytesC := (BytesA + BytesB) * i;
  1053.     end;
  1054.  
  1055.     { store the results in the output string }
  1056.     T    := '1234567';
  1057.     T[1] := S[0];
  1058.     T[2] := S[1];
  1059.     T[3] := chr(lo(BytesA));
  1060.     T[4] := chr(hi(BytesA));
  1061.     T[5] := chr(BytesB);
  1062.     T[6] := chr(lo(BytesC));
  1063.     T[7] := chr(hi(BytesC));
  1064.   end
  1065.   else T := S;  { simply store the original string to return }
  1066.   CompressString := T;
  1067. end;
  1068.  
  1069. Begin
  1070.   Initialize;
  1071.   Process;
  1072.   WrapUp;
  1073. End.
  1074.  
  1075.